Pascal Super Library/Pascal Super Library (CW International)(1997).bin/STRINGS/OPUNIQ/OPTREE.PAS

Pascal/Delphi Source File | 1990-10-25 | 5KB | 229 lines

{$S-,R-,V-,I-,B-,F+,O-,A-}

{Updated 10/24/90 to add a Remove method to the Tree object}

unit OpTree;
  {-Binary tree object}

interface

uses
  OpString, OpRoot;

type
  TreeNodePtr = ^TreeNode;
  TreeNode =
    object(Root)
      tnLeft, tnRight : TreeNodePtr; {Pointers to children}
      constructor Init;
        {-Initialize children to nil}
    end;

  TreePtr = ^Tree;
  TreeActionProc = procedure (N : TreeNodePtr; T : TreePtr);
  Tree =
    object(Root)
      trRoot : TreeNodePtr;

      constructor Init;
        {-Create an empty tree}
      destructor Done; virtual;
        {-Dispose of entire tree}
      procedure Clear;
        {-Dispose of all elements of tree}
      function Empty : Boolean;
        {-Return True if Tree is empty}
      procedure Insert(N : TreeNodePtr);
        {-Insert a new node into tree}
      procedure Remove(N : TreeNodePtr);
        {-Remove an existing node from tree}
      function Find(Key : Pointer) : TreeNodePtr;
        {-Return a pointer to TreeNode having a key pointed to by Key}
      procedure VisitNodesUp(Action : TreeActionProc);
        {-Visit all nodes in ascending order and call Action procedure}

      {-- methods to be overridden by descendants --}
      function Compare(Key1, Key2 : Pointer) : CompareType; virtual;
        {-Compare two keys, returning Less, Equal, Greater}
      function GetKey(N : TreeNodePtr) : Pointer; virtual;
        {-Return a pointer to the key value for node N}
    end;

  {====================================================================}

implementation

constructor TreeNode.Init;
  {-Initialize children to nil}
begin
  if not Root.Init then
    Fail;
  tnLeft := nil;
  tnRight := nil;
end;

  {--------------------------------------------------------------------}

constructor Tree.Init;
  {-Create an empty tree}
begin
  if not Root.Init then
    Fail;
  trRoot := nil;
end;

destructor Tree.Done;
  {-Dispose of entire tree}
begin
  Clear;
end;

procedure DeleteNode(N : TreeNodePtr; T : TreePtr);
  {-Dispose of node N}
begin
  Dispose(N, Done);
end;

procedure Tree.Clear;
  {-Dispose of all elements of tree}
begin
  VisitNodesUp(DeleteNode);
end;

function Tree.Empty : Boolean;
  {-Return True if Tree is empty}
begin
  Empty := (trRoot = nil);
end;

procedure Tree.Insert(N : TreeNodePtr);
  {-Insert a new node into tree}
var
  Key : Pointer;

  procedure Visit(var P : TreeNodePtr);
    {-Visit node P and its children}
  begin
    if P = nil then
      {Link new node into tree}
      P := N
    else
      case Compare(Key, GetKey(P)) of
        Less :
          Visit(P^.tnLeft);
        Greater :
          Visit(P^.tnRight);
        Equal :
          {Already in tree, do nothing} ;
      end;
  end;

begin
  Key := GetKey(N);
  Visit(trRoot);
end;

procedure Tree.Remove(N : TreeNodePtr);
  {-Remove an existing node from tree}
var
  Key : Pointer;

  procedure Visit(var P : TreeNodePtr);
    {-Visit node P and its children}

    procedure Rem(var R : TreeNodePtr);
      {-Find leftmost node of right subtree and replace P with it}
    begin
      if R^.tnRight <> nil then
        Rem(R^.tnRight)
      else begin
        R^.tnRight := P^.tnRight;
        P := R;
      end;
    end;

  begin
    if P = nil then
      {Node is not in tree, do nothing}
    else
      case Compare(Key, GetKey(P)) of
        Less :
          Visit(P^.tnLeft);
        Greater :
          Visit(P^.tnRight);
        Equal :
          {Found node to delete}
          if P^.tnRight = nil then
            {Replace P with its left child}
            P := P^.tnLeft
          else if P^.tnLeft = nil then
            {Replace P with its right child}
            P := P^.tnRight
          else
            {Replace P with leftmost node of right subtree}
            Rem(P^.tnLeft);
      end;
  end;

begin
  Key := GetKey(N);
  Visit(trRoot);
end;

function Tree.Find(Key : Pointer) : TreeNodePtr;
  {-Return a pointer to TreeNode having a key pointed to by Key}

  procedure Visit(N : TreeNodePtr);
    {-Visit node N and its children}
  begin
    if N = nil then
      Find := nil
    else
      case Compare(Key, GetKey(N)) of
        Less :
          Visit(N^.tnLeft);
        Greater :
          Visit(N^.tnRight);
        Equal :
          Find := N;
      end;
  end;

begin
  Visit(trRoot);
end;

procedure Tree.VisitNodesUp(Action : TreeActionProc);
  {-Visit all nodes in ascending order and call Action procedure}

  procedure VisitUp(N : TreeNodePtr);
    {-Visit node N and its children}
  var
    R : TreeNodePtr;
  begin
    if N <> nil then begin
      R := N^.tnRight;
      VisitUp(N^.tnLeft);
      Action(N, @Self);
      VisitUp(R);
    end;
  end;

begin
  VisitUp(trRoot);
end;

function Tree.Compare(Key1, Key2 : Pointer) : CompareType;
  {-Compare two keys, returning Less, Equal, Greater}
begin
  Compare := Equal;
end;

function Tree.GetKey(N : TreeNodePtr) : Pointer;
  {-Return a pointer to the key value for node N}
begin
  GetKey := nil;
end;

end.